home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / bipl.zip / PROGS.ZIP / XTABLE.ICN < prev    next >
Text File  |  1992-11-26  |  3KB  |  135 lines
  1. ############################################################################
  2. #
  3. #    File:     xtable.icn
  4. #
  5. #    Subject:  Program to show character code translations
  6. #
  7. #    Author:   Robert J. Alexander, modified by Alan Beale
  8. #
  9. #    Date:     July 20, 1991
  10. #
  11. ###########################################################################
  12. #
  13. #  Program to print various character translation tables.  See
  14. #  procedure help() for the capabilities.
  15. #
  16. ############################################################################
  17. #
  18. #  Links: options, colmize, hexcvt, ebcdic
  19. #
  20. ############################################################################
  21.  
  22. link options, colmize, hexcvt, ebcdic
  23.  
  24. global Graphic, Conv
  25.  
  26. procedure main(arg)
  27.    local opt
  28.  
  29.    opt := options(arg,"acedo")
  30.    Conv := if \opt["d"] then "d" else if \opt["o"] then "o"
  31.    init()
  32.    every write(colmize(
  33.      if \opt["a"] then ASCII()
  34.      else if \opt["e"] then EBCDIC()
  35.      else if \opt["c"] then ASCIICtrl()
  36.      else help()
  37.    ))
  38. end
  39.  
  40. procedure help()
  41.    write("Usage: xtable -<option>")
  42.    write("Options:")
  43.    write("\ta: ASCII table")
  44.    write("\tc: ASCII control char table")
  45.    write("\te: EBCDIC table")
  46.    write("\td: decimal numbers")
  47.    write("\te: octal numbers")
  48. end
  49.  
  50. procedure init()
  51.    Graphic := cset(Ascii128()[33:-1])
  52. end
  53.  
  54. procedure ASCII()
  55.    local c,i,lst,a128
  56.    lst := []
  57.    a128 := Ascii128()
  58.    every c := !a128 do {
  59.       i := AsciiOrd(c)
  60.       if not any(Graphic,c) then {
  61.      c := image(c)[2:-1]
  62.      if match("\\x",c) then next
  63.      }
  64.       put(lst,"|  " || convert(i) || " " || c)
  65.       }
  66.    return lst
  67. end
  68.  
  69. procedure ASCIICtrl()
  70.    local a,c,ctrls,i,lst,a128
  71.    ctrls := "\^ \^!\^"\^#\^$\^%\^&\^'\^(\^)\^*\^+\^,\^-\^.\^/_
  72.      \^0\^1\^2\^3\^4\^5\^6\^7\^8\^9\^:\^;\^<\^=\^>\^?\^@_
  73.      \^A\^B\^C\^D\^E\^F\^G\^H\^I\^J\^K\^L\^M_
  74.      \^N\^O\^P\^Q\^R\^S\^T\^U\^V\^W\^X\^Y\^Z_
  75.      \^[\^\\^]\^^\^_\^`_
  76.      \^a\^b\^c\^d\^e\^f\^g\^h\^i\^j\^k\^l\^m_
  77.      \^n\^o\^p\^q\^r\^s\^t\^u\^v\^w\^x\^y\^z_
  78.      \^{\^|\^}\^~"
  79.    lst := []
  80.    a128 := Ascii128()
  81.    a := create !a128[33:-1]
  82.    every c := !ctrls do {
  83.       i := AsciiOrd(c)
  84.       put(lst,"|  " || convert(i) || " ^" || @a)
  85.       }
  86.    return lst
  87. end
  88.  
  89. procedure EBCDIC()
  90.    local EBCDICMap,c,i,lst
  91.    EBCDICMap := repl(".",64) ||                    # 00 - 3F
  92.      " ...........<(+|&.........!$*);^" ||     # 40 - 5F
  93.      "-/.........,%_>?.........`:#@'=\"" ||    # 60 - 7F
  94.      ".abcdefghi.......jklmnopqr......" ||     # 80 - 9F
  95.      ".~stuvwxyz...[...............].." ||     # A0 - BF
  96.      "{ABCDEFGHI......}JKLMNOPQR......" ||     # C0 - CF
  97.      "\\.STUVWXYZ......0123456789......"       # E0 - FF
  98.    lst := []
  99.    i := -1
  100.    every c := !EBCDICMap do {
  101.       i +:= 1
  102.       if i = 16r4B | "." ~== c then
  103.         put(lst,"|  " || convert(i) || " " || c)
  104.       }
  105.    return lst
  106. end
  107.  
  108. procedure convert(n)
  109.    return case Conv of {
  110.       "d": right(n,3,"0")
  111.       "o": octstring(n,3)
  112.       default: hexstring(n,2)
  113.       }
  114. end
  115.  
  116. #
  117. #  octstring() -- Returns a string that is the octal
  118. #  representation of the argument.
  119. #
  120. procedure octstring(i,n)
  121.    local s
  122.    i := integer(i) | fail
  123.    if i = 0 then s := "0"
  124.    else {
  125.     s := ""
  126.     while i ~= 0 do {
  127.         s := iand(i,7) || s
  128.         i := ishift(i,-3)
  129.         }
  130.     }
  131.    s := right(s,\n,"0")
  132.    return s
  133. end
  134.  
  135.